﻿Imports System.IO
Imports VBIDE

Module RebuildModuleCode
    ' Function:   RebuildModule
    '
    ' Comments:   This procedure goes through the lines in a module,
    '             rebuilding the code's indenting.
    '
    ' Arguments:  modCode    - 待缩进的模块
    '             sName      - The display name of the item being indented
    '             iStartLine - 代码缩进的起始行
    '             iEndLine   - 代码缩进的终止行
    '             iProgDone  - Value giving how much indenting has been done in total
    '为注册表定义一些常量
    Public Const psREG_SECTION As String = "Business Modelling Solutions Ltd."
    Public Const psAPP_TITLE As String = "Smart Indenter VB"
    Public Const psREG_KEY As String = "Smart Indenter"
    Public Const psMENU_TAG As String = "INDENT2K"

    '为菜单定义一些常量
    Public Const msMENU_TEXT As String = "&Smart Indent"
    Public Const msMENU_PROC As String = "Indent P&rocedure"
    Public Const msMENU_MOD As String = "Indent Mo&dule"
    Public Const msMENU_PROJ As String = "Indent Pro&ject"
    Public Const msMENU_FORM As String = "&Indenting Options"
    Public Const msMENU_ABOUT As String = "About Smart Indenter VB"

    Const miTAB As Integer = 9

    'Variant arrays to hold the code items to look for

    Dim mbContinued As Boolean

    '存储设置的一些变量
    Public mbIndentProc As Boolean
    Public mbIndentCmt As Boolean
    Public mbIndentCase As Boolean
    Public mbIndentFirst As Boolean
    Public mbAlignEOL As Boolean
    Public miIndentSpaces As Integer
    Public miAlignEOLCol As Integer

    Public mvasInCode As Object
    Public mvasOutProc As Object
    Public mvasOutCode As Object
    Public mvasInProc As Object




    Public Sub RebuildModule(modCode As CodeModule, sName As String, iStartLine As Long, iEndline As Long, iProgDone As Long)

        'Variables used for the indenting code
        Dim x As Integer, i As Integer, j As Integer, k As Integer
        Dim lLineCount As Integer, iCommentStart As Integer, iStart As Integer, iScan As Integer
        Dim iIndents As Integer, iIndentNext As Integer, iIn As Integer, iOut As Integer
        Dim bInCmt As Boolean, bFirstProcLine As Boolean, bProcStart As Boolean, bInString As Boolean
        Dim sLine As String, sLeft As String, sRight As String, sPad As String
        Dim vaScope As Object, vaStatic As Object, vaType As Object

        'On Error Resume Next

        'Variant arrays to hold the code items to look for



        'Variables to hold our indenting options
        Dim mbIndentProc As Boolean, mbIndentCmt As Boolean, mbIndentCase As Boolean
        Dim mbIndentFirst As Boolean, mbAlignEOL As Boolean
        Dim miIndentSpaces As Integer, miAlignEOLCol As Integer
        'Read the indenting options from the registry
        mbIndentProc = (GetSetting(psREG_SECTION, psREG_KEY, "IndentProc", "Y") = "Y")
        mbIndentCmt = (GetSetting(psREG_SECTION, psREG_KEY, "IndentCmt", "Y") = "Y")
        mbIndentCase = (GetSetting(psREG_SECTION, psREG_KEY, "IndentCase", "Y") = "Y")
        mbIndentFirst = (GetSetting(psREG_SECTION, psREG_KEY, "IndentFirst", "Y") = "Y")
        mbAlignEOL = (GetSetting(psREG_SECTION, psREG_KEY, "AlignEOL", "Y") = "Y")
        miAlignEOLCol = Val(GetSetting(psREG_SECTION, psREG_KEY, "AlignEOLCol", "60"))
        miIndentSpaces = Val(GetSetting(psREG_SECTION, psREG_KEY, "IndentSpaces", "4"))

        '创建与过程级缩进匹配的项目列表
        vaScope = {"", "Public ", "Private ", "Friend "}
        vaStatic = {"", "Static "}
        vaType = {"Sub", "Function", "Property Let", "Property Get", "Property Set", "Type", "Enum"}

        x = 1
        ReDim mvasInProc(1)
        For i = 0 To UBound(vaScope)
            For j = 0 To UBound(vaStatic)
                For k = 0 To UBound(vaType)
                    ReDim Preserve mvasInProc(x)
                    mvasInProc(x) = vaScope(i) & vaStatic(j) & vaType(k)
                    x = x + 1
                Next
            Next
        Next

        '在程序内缩进时要匹配的项目
        mvasInCode = {"If", "ElseIf", "Else", "#If", "#ElseIf", "#Else", "Select Case", "Case", "With", "For", "Do", "While"}

        '在程序级别出列时要匹配的项目
        mvasOutProc = {"End Sub", "End Function", "End Property", "End Type", "End Enum"}

        '在过程中输出时要匹配的项
        mvasOutCode = {"ElseIf", "Else", "End If", "#ElseIf", "#Else", "#End If", "Case", "End Select", "End With", "Next", "Loop", "Wend"}

        '如果Select Case语句中存在额外的缩进，请将项目添加到两个字符串中两次
        If mbIndentCase Then
            ReDim Preserve mvasInCode(UBound(mvasInCode) + 1)
            mvasInCode(UBound(mvasInCode)) = "Select Case"

            ReDim Preserve mvasOutCode(UBound(mvasOutCode) + 1)
            mvasOutCode(UBound(mvasOutCode)) = "End Select"
        End If

        '标记行是否位于过程的顶部
        bProcStart = False
        'Loop through all the lines to indent
        For lLineCount = iStartLine To iEndline '逐行遍历代码
            'Read the line of code to indent
            sLine = Trim$(modCode.Lines(lLineCount, 1))
            'If we're not in a continued line, initialise some variables如果我们不是在一个连续的行中，初始化一些变量
            If Not mbContinued Then iIndentNext = 0 : bFirstProcLine = False
            'Is there anything on the line?
            If Len(sLine) > 0 Then
                ' Remove leading Tabs
                Do Until Left(sLine, 1) <> Chr(miTAB)
                    sLine = Mid(sLine, 2)
                Loop

                ' Add an extra space on the end'增加一个额外的空格在语句最后
                sLine = sLine & " "

                ' Flag to see if we're inside a string in the code标记以查看我们是否在代码中的字符串中
                bInString = False

                'Remember the position of the line segment记住代码段的位置
                iStart = 1

                'Scan through the line, character by character, checking for'逐行扫描，逐个字符，检查
                'strings, multi-statement lines  and comments'字符串、多语句行和注释
                For iScan = 1 To Len(sLine)

                    'Check for a string - ignore everything within it
                    If Mid(sLine, iScan, 1) = """" Then bInString = Not bInString '检查字符串-忽略其中的所有内容

                    'Are we inside a string (i.e. ignoring everything)?我们是否在一个字符串中（即忽略所有内容）？
                    If Not bInString Then

                        'No, Is it a multi-statement line separator?不，它是多语句行分隔符吗？
                        If Mid(sLine, iScan, 2) = ": " Then

                            'Yes, so tidy up the separator是的，所以把分隔符整理一下
                            sLine = Left(sLine, iScan + 1) & Trim(Mid(sLine, iScan + 2))

                            'And check the indenting for the line segment
                            CheckLine(Mid(sLine, iStart, iScan - 1), iIn, iOut, bProcStart, bFirstProcLine)
                            If iStart = 1 Then
                                iIndents = iIndents - iOut
                                If iIndents < 0 Then iIndents = 0
                                iIndentNext = iIndentNext + iIn
                            Else
                                iIndentNext = iIndentNext + iIn - iOut
                            End If

                            'Update the pointer and continue
                            iStart = iScan + 2
                        End If

                        'Is it the start of a comment or are we inside a continued comment?这是注释的开始还是在注释内部？
                        If Mid(sLine, iScan, 1) = "'" Or Mid(sLine, iScan, 4) = "Rem " Or bInCmt Then

                            If bInCmt Then
                                'Within a multi-line comment - indent to line up the comment text
                                sLine = Space(iCommentStart) & sLine
                            Else
                                If iScan = 1 Then
                                    'New comment at start of line
                                    If mbIndentFirst Or (mbIndentCmt And Not bProcStart) Then
                                        'Inside the procedure, so indent to align with code
                                        sLine = Space(iIndents * miIndentSpaces) & sLine

                                    ElseIf iIndents > 0 And mbIndentProc And Not bProcStart Then
                                        'At the top of the procedure, so indent once if required
                                        sLine = Space(miIndentSpaces) & sLine
                                    End If

                                    'Remember where the comment starts for the following line
                                    iCommentStart = iScan + iIndents * miIndentSpaces + 1
                                Else
                                    'New comment at the end of a line

                                    'Check the indenting of the previous code segment
                                    CheckLine(Mid(sLine, iStart, iScan - 1), iIn, iOut, bProcStart, bFirstProcLine)
                                    If iStart = 1 Then
                                        iIndents = iIndents - iOut
                                        If iIndents < 0 Then iIndents = 0
                                        iIndentNext = iIndentNext + iIn
                                    Else
                                        iIndentNext = iIndentNext + iIn - iOut
                                    End If

                                    'Get the text before the comment, and the comment text
                                    sLeft = Trim(Left(sLine, iScan - 1))
                                    sRight = Trim(Mid(sLine, iScan))

                                    'Indent the code part of the line
                                    If mbContinued Then
                                        sLine = Space((iIndents + 2) * miIndentSpaces) & sLeft
                                    Else
                                        sLine = Space(iIndents * miIndentSpaces) & sLeft
                                    End If

                                    mbContinued = (Right(Trim(sLine), 2) = " _")

                                    'Should we indent the comment to a specific column?
                                    If mbAlignEOL And Len(sLine) < miAlignEOLCol Then

                                        'Yes, so put the comment in the required column
                                        sLine = sLine & Space(miAlignEOLCol - Len(sLine) - 1) & sRight
                                        iCommentStart = miAlignEOLCol + 1
                                    Else
                                        'No, just add it on the end of the code, with a standard gap width
                                        If miIndentSpaces = 0 Then
                                            sLine = sLine & " " & sRight
                                        Else
                                            sLine = sLine & Space(miIndentSpaces) & sRight
                                        End If
                                        iCommentStart = Len(sLine) - Len(sRight) + 1
                                    End If
                                End If

                                'Work out where the text of the comment starts, to align the next line
                                If Mid(sLine, iCommentStart, 4) = "Rem " Then iCommentStart = iCommentStart + 3
                                Do Until Mid(sLine, iCommentStart, 1) <> " "
                                    iCommentStart = iCommentStart + 1
                                Loop
                                iCommentStart = iCommentStart - 1
                            End If

                            'Remember if we're in a continued comment line
                            bInCmt = Right(Trim(sLine), 2) = " _"
                            GoTo PTR_REPLACE_LINE
                        End If    'Start of a comment
                    End If    'Inside a string
                Next    'Part of the line

                'Do we have some code left to check?我们还有代码要检查吗？
                '(i.e. a line without a comment or the last segment of a multi-statement line)（即没有注释的行或多语句行的最后一段）
                If iStart < Len(sLine) Then

                    'If it's not part of a continuation line, assume we're not at the first line of the procedure
                    If Not mbContinued Then bProcStart = False

                    'Check the indenting of the remaining code segment
                    CheckLine(Mid(sLine, iStart), iIn, iOut, bProcStart, bFirstProcLine)

                    If iStart = 1 Then
                        iIndents = iIndents - iOut
                        If iIndents < 0 Then iIndents = 0
                        iIndentNext = iIndentNext + iIn
                    Else
                        iIndentNext = iIndentNext + iIn - iOut
                    End If
                End If

                ' What about line continuations?  Here, I indent the continued line by
                ' two indents, and check for the end of the continuations.  Note
                ' that Excel won't allow comments in the middle of line continuations
                ' and that comments are treated differently above.

                If mbContinued Then
                    sLine = Space((iIndents + 2 + iProgDone) * miIndentSpaces + iProgDone) & sLine
                Else
                    sLine = Space(iIndents * miIndentSpaces + iProgDone) & sLine
                End If

                mbContinued = (Right(Trim(sLine), 2) = " _")

            End If    'Anything there?

PTR_REPLACE_LINE:

            'In the O2K VBE, it's safe to indent the Sub lines, but we can't do it when
            'indenting within VB6

            'If IsO2KVBE() Or Not bFirstProcLine Then modCode.ReplaceLine(lLineCount, RTrim(sLine))

            If Not bFirstProcLine Then '如果判定是首行，则无需加前缀。如果非首行，需要加空格前缀。
                If Val(ReadOneString("配置信息", "是否顶级缩进", Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) & "\配置.ini")) = 1 Then
                    modCode.ReplaceLine(lLineCount, RTrim(sLine))
                Else
                    modCode.ReplaceLine(lLineCount, "    " & RTrim(sLine))
                End If
            Else
                modCode.ReplaceLine(lLineCount, Trim(sLine))
            End If


            'If it's not a continued line, update the indenting for the following lines
            If Not mbContinued Then
                iIndents = iIndents + iIndentNext
                iIndentNext = 0
                If iIndents < 0 Then iIndents = 0
            End If
        Next

    End Sub

    '
    '  Check the line (segment) to see if it needs in- or out-denting
    '
    Function CheckLine(ByVal sLine As String, ByRef iIndentNext As Integer, ByRef iOutdentThis As Integer, ByRef bProcStart As Boolean, ByRef bFirstProcLine As Boolean)


        Dim i As Integer, j As Integer, sMatch As String, sTmp As String
        Static bInIf As Boolean, bNoIndent As Boolean

        'Assume we don't indent or outdent the code假设我们不缩进或缩进代码
        iIndentNext = 0
        iOutdentThis = 0

        'Tidy up the line
        sLine = Trim(sLine) & " "

        'We don't check within Type and Enums
        If Not bNoIndent Then

            ' Check for indenting within the code
            For i = LBound(mvasInCode) To UBound(mvasInCode)
                sMatch = UCase(mvasInCode(i))
                If (UCase(Left(sLine, Len(sMatch))) = sMatch) And ((Mid(sLine, Len(sMatch) + 1, 1) = " ") Or (Mid(sLine, Len(sMatch) + 1, 1) = ":")) Then
                    iIndentNext = iIndentNext + 1
                End If
            Next

            ' Check for out-denting within the code
            For i = LBound(mvasOutCode) To UBound(mvasOutCode)
                sMatch = UCase(mvasOutCode(i))
                'Check at start of line for 'real' outdenting
                If (UCase(Left(sLine, Len(sMatch))) = sMatch) And ((Mid(sLine, Len(sMatch) + 1, 1) = " ") Or (Mid(sLine, Len(sMatch) + 1, 1) = ":")) Then
                    iOutdentThis = iOutdentThis + 1
                End If
            Next
        End If

        'Check procedure-level indenting
        Dim aaa As Object = mvasInProc
        For i = LBound(mvasInProc) To UBound(mvasInProc)

            sMatch = UCase(mvasInProc(i))
            If (UCase(Left(sLine, Len(sMatch))) = sMatch) And ((Mid(sLine, Len(sMatch) + 1, 1) = " ") Or (Mid(sLine, Len(sMatch) + 1, 1) = ":")) Then

                If mbIndentProc And Not bNoIndent Then
                    iIndentNext = iIndentNext + 1
                End If
                bProcStart = True
                bFirstProcLine = True
                'Don't indent within Type or Enum constructs不在类型或枚举构造中缩进
                'If Right(sMatch, 4) = "TYPE" Or Right(sMatch, 4) = "ENUM" Then bNoIndent = True
            End If
        Next

        'Check procedure-level outdenting

        For i = LBound(mvasOutProc) To UBound(mvasOutProc)
            sMatch = UCase(mvasOutProc(i))
            If (UCase(Left(sLine, Len(sMatch))) = sMatch) And ((Mid(sLine, Len(sMatch) + 1, 1) = " ") Or (Mid(sLine, Len(sMatch) + 1, 1) = ":")) Then

                If mbIndentProc Then
                    bNoIndent = False

                    iOutdentThis = iOutdentThis + 1
                End If
                bFirstProcLine = True '//末尾行也顶头缩进
            End If
        Next

        'If we're not indenting, no need to consider the special cases
        If bNoIndent Then Exit Function

        ' Treat If as a special case.  If anything other than a comment follows
        ' the Then, we don't indent
        If Left(sLine, 3) = "If " Or Left(sLine, 4) = "#If " Or bInIf Then

            If bInIf Then iIndentNext = 1

            ' Allow for line continuations within the If statement
            bInIf = (Right(Trim(sLine), 2) = " _")

            'Strip any strings from the line
            i = InStr(1, sLine, """")
            Do Until i = 0
                j = InStr(i + 1, sLine, """")
                If j = 0 Then j = Len(sLine)
                sLine = Left(sLine, i - 1) & Mid(sLine, j + 1)
                i = InStr(1, sLine, """")
            Loop

            'And strip comments
            i = InStr(1, sLine, "'")
            If i > 0 Then sLine = Left(sLine, i - 1)

            ' Do we have a Then statement in the line.  Adding a space on the
            ' end of the test means we can test for Then being both within or
            ' at the end of the line
            sLine = " " & sLine & " "
            i = InStr(1, sLine, " Then ")

            If i > 0 Then
                ' If there's something after the Then, we don't indent the If
                If Trim(Mid(sLine, i + 5)) <> "" Then iIndentNext = 0

                ' No need to check next time around
                bInIf = False
            End If

            If bInIf Then iIndentNext = 0
        End If
    End Function

End Module
